home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 October / macformat-005.iso / Shareware City / Developers / xlispmac / lisp / SORT.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1994-05-28  |  1.5 KB  |  45 lines  |  [TEXT/xlsp]
  1. ;; Sort routines.  
  2. ;; by Tom Almy
  3.  
  4.  
  5. ;; The built in sort does a quick sort which does a bad job if the list is
  6. ;; already sorted.  INSERT is a destructive insertion into a sorted list.
  7. ;; Also, these are iterative and will handle lists of any size.  SORT can
  8. ;; cause eval stack overflows on big lists.
  9. ;; In these functions, "function" is a predicate that orders the list
  10. ;; (For numbers, typically #'< ).
  11. (defun insert (element list function)
  12.     (cond ((null list) (list element))
  13.           ((funcall function element (first list))
  14.            (cons element list))
  15.           (t (do ((prev list (rest prev)))
  16.                    ((or (endp (rest prev)) 
  17.                    (funcall function element (second prev)))
  18.               (rplacd prev (cons element (rest prev)))
  19.               list)))))
  20.  
  21. ;; And this inserts a list of items into an existing list (which can be nil)
  22.  
  23. (defun insertall (elements list function)
  24.     (dolist (element elements list)
  25.         (setq list (insert element list function))))
  26.  
  27.  
  28. ;; Once the list has been sorted, accessing is faster if the list is
  29. ;; placed in an array, and a binary search is performed.
  30. ;; The advantage starts at about 250 elements
  31.  
  32. (defun memarray (element array &key (test #'eql) (function #'<))
  33.     (let* ((max (1- (length array)))
  34.           (min 0)
  35.           (index (/ (+ max min) 2)))
  36.          (loop (when (funcall test element (aref array index))
  37.                   (return index))
  38.            (if (funcall function element (aref array index))
  39.                (setq max (1- index))
  40.                (setq min (1+ index)))
  41.            (when (> min max) (return nil))
  42.            (setq index (/ (+ max min) 2)))))
  43.  
  44.  
  45.